home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / generic / tclClock.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  7.5 KB  |  308 lines  |  [TEXT/CWIE]
  1. /* 
  2.  * tclClock.c --
  3.  *
  4.  *    Contains the time and date related commands.  This code
  5.  *    is derived from the time and date facilities of TclX,
  6.  *    by Mark Diekhans and Karl Lehenbauer.
  7.  *
  8.  * Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans.
  9.  * Copyright (c) 1995 Sun Microsystems, Inc.
  10.  *
  11.  * See the file "license.terms" for information on usage and redistribution
  12.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13.  *
  14.  * SCCS: @(#) tclClock.c 1.37 97/07/29 10:29:58
  15.  */
  16.  
  17. #include "tcl.h"
  18. #include "tclInt.h"
  19. #include "tclPort.h"
  20.  
  21. /*
  22.  * Function prototypes for local procedures in this file:
  23.  */
  24.  
  25. static int        FormatClock _ANSI_ARGS_((Tcl_Interp *interp,
  26.                 unsigned long clockVal, int useGMT,
  27.                 char *format));
  28.  
  29. /*
  30.  *-------------------------------------------------------------------------
  31.  *
  32.  * Tcl_ClockObjCmd --
  33.  *
  34.  *    This procedure is invoked to process the "clock" Tcl command.
  35.  *    See the user documentation for details on what it does.
  36.  *
  37.  * Results:
  38.  *    A standard Tcl result.
  39.  *
  40.  * Side effects:
  41.  *    See the user documentation.
  42.  *
  43.  *-------------------------------------------------------------------------
  44.  */
  45.  
  46. int
  47. Tcl_ClockObjCmd (client, interp, objc, objv)
  48.     ClientData client;            /* Not used. */
  49.     Tcl_Interp *interp;            /* Current interpreter. */
  50.     int objc;                /* Number of arguments. */
  51.     Tcl_Obj *CONST objv[];        /* Argument values. */
  52. {
  53.     Tcl_Obj *resultPtr;
  54.     int index;
  55.     Tcl_Obj *CONST *objPtr;
  56.     int useGMT = 0;
  57.     char *format = "%a %b %d %X %Z %Y";
  58.     int dummy;
  59.     unsigned long baseClock, clockVal;
  60.     long zone;
  61.     Tcl_Obj *baseObjPtr = NULL;
  62.     char *scanStr;
  63.     
  64.     static char *switches[] =
  65.         {"clicks", "format", "scan", "seconds", (char *) NULL};
  66.     static char *formatSwitches[] = {"-format", "-gmt", (char *) NULL};
  67.     static char *scanSwitches[] = {"-base", "-gmt", (char *) NULL};
  68.  
  69.     resultPtr = Tcl_GetObjResult(interp);
  70.     if (objc < 2) {
  71.     Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
  72.     return TCL_ERROR;
  73.     }
  74.  
  75.     if (Tcl_GetIndexFromObj(interp, objv[1], switches, "option", 0, &index)
  76.         != TCL_OK) {
  77.     return TCL_ERROR;
  78.     }
  79.     switch (index) {
  80.     case 0:            /* clicks */
  81.         if (objc != 2) {
  82.         Tcl_WrongNumArgs(interp, 2, objv, NULL);
  83.         return TCL_ERROR;
  84.         }
  85.         Tcl_SetLongObj(resultPtr, (long) TclpGetClicks());
  86.         return TCL_OK;
  87.     case 1:            /* format */
  88.         if ((objc < 3) || (objc > 7)) {
  89.         wrongFmtArgs:
  90.         Tcl_WrongNumArgs(interp, 2, objv,
  91.             "clockval ?-format string? ?-gmt boolean?");
  92.         return TCL_ERROR;
  93.         }
  94.  
  95.         if (Tcl_GetLongFromObj(interp, objv[2], (long*) &clockVal)
  96.             != TCL_OK) {
  97.         return TCL_ERROR;
  98.         }
  99.     
  100.         objPtr = objv+3;
  101.         objc -= 3;
  102.         while (objc > 1) {
  103.         if (Tcl_GetIndexFromObj(interp, objPtr[0], formatSwitches,
  104.             "switch", 0, &index) != TCL_OK) {
  105.             return TCL_ERROR;
  106.         }
  107.         switch (index) {
  108.             case 0:        /* -format */
  109.             format = Tcl_GetStringFromObj(objPtr[1], &dummy);
  110.             break;
  111.             case 1:        /* -gmt */
  112.             if (Tcl_GetBooleanFromObj(interp, objPtr[1],
  113.                 &useGMT) != TCL_OK) {
  114.                 return TCL_ERROR;
  115.             }
  116.             break;
  117.         }
  118.         objPtr += 2;
  119.         objc -= 2;
  120.         }
  121.         if (objc != 0) {
  122.         goto wrongFmtArgs;
  123.         }
  124.         return FormatClock(interp, (unsigned long) clockVal, useGMT,
  125.             format);
  126.     case 2:            /* scan */
  127.         if ((objc < 3) || (objc > 7)) {
  128.         wrongScanArgs:
  129.         Tcl_WrongNumArgs(interp, 2, objv,
  130.             "dateString ?-base clockValue? ?-gmt boolean?");
  131.         return TCL_ERROR;
  132.         }
  133.  
  134.         objPtr = objv+3;
  135.         objc -= 3;
  136.         while (objc > 1) {
  137.         if (Tcl_GetIndexFromObj(interp, objPtr[0], scanSwitches,
  138.             "switch", 0, &index) != TCL_OK) {
  139.             return TCL_ERROR;
  140.         }
  141.         switch (index) {
  142.             case 0:        /* -base */
  143.             baseObjPtr = objPtr[1];
  144.             break;
  145.             case 1:        /* -gmt */
  146.             if (Tcl_GetBooleanFromObj(interp, objPtr[1],
  147.                 &useGMT) != TCL_OK) {
  148.                 return TCL_ERROR;
  149.             }
  150.             break;
  151.         }
  152.         objPtr += 2;
  153.         objc -= 2;
  154.         }
  155.         if (objc != 0) {
  156.         goto wrongScanArgs;
  157.         }
  158.  
  159.         if (baseObjPtr != NULL) {
  160.         if (Tcl_GetLongFromObj(interp, baseObjPtr,
  161.             (long*) &baseClock) != TCL_OK) {
  162.             return TCL_ERROR;
  163.         }
  164.         } else {
  165.         baseClock = TclpGetSeconds();
  166.         }
  167.  
  168.         if (useGMT) {
  169.         zone = -50000; /* Force GMT */
  170.         } else {
  171.         zone = TclpGetTimeZone((unsigned long) baseClock);
  172.         }
  173.  
  174.         scanStr = Tcl_GetStringFromObj(objv[2], &dummy);
  175.         if (TclGetDate(scanStr, (unsigned long) baseClock, zone,
  176.             (unsigned long *) &clockVal) < 0) {
  177.         Tcl_AppendStringsToObj(resultPtr,
  178.             "unable to convert date-time string \"",
  179.             scanStr, "\"", (char *) NULL);
  180.         return TCL_ERROR;
  181.         }
  182.  
  183.         Tcl_SetLongObj(resultPtr, (long) clockVal);
  184.         return TCL_OK;
  185.     case 3:            /* seconds */
  186.         if (objc != 2) {
  187.         Tcl_WrongNumArgs(interp, 2, objv, NULL);
  188.         return TCL_ERROR;
  189.         }
  190.         Tcl_SetLongObj(resultPtr, (long) TclpGetSeconds());
  191.         return TCL_OK;
  192.     default:
  193.         return TCL_ERROR;    /* Should never be reached. */
  194.     }
  195. }
  196.  
  197. /*
  198.  *-----------------------------------------------------------------------------
  199.  *
  200.  * FormatClock --
  201.  *
  202.  *      Formats a time value based on seconds into a human readable
  203.  *    string.
  204.  *
  205.  * Results:
  206.  *      Standard Tcl result.
  207.  *
  208.  * Side effects:
  209.  *      None.
  210.  *
  211.  *-----------------------------------------------------------------------------
  212.  */
  213.  
  214. static int
  215. FormatClock(interp, clockVal, useGMT, format)
  216.     Tcl_Interp *interp;            /* Current interpreter. */
  217.     unsigned long clockVal;               /* Time in seconds. */
  218.     int useGMT;                /* Boolean */
  219.     char *format;            /* Format string */
  220. {
  221.     struct tm *timeDataPtr;
  222.     Tcl_DString buffer;
  223.     int bufSize;
  224.     char *p;
  225. #ifdef TCL_USE_TIMEZONE_VAR
  226.     int savedTimeZone;
  227.     char *savedTZEnv;
  228. #endif
  229.     Tcl_Obj *resultPtr;
  230.  
  231.     resultPtr = Tcl_GetObjResult(interp);
  232. #ifdef HAVE_TZSET
  233.     /*
  234.      * Some systems forgot to call tzset in localtime, make sure its done.
  235.      */
  236.     static int  calledTzset = 0;
  237.  
  238.     if (!calledTzset) {
  239.         tzset();
  240.         calledTzset = 1;
  241.     }
  242. #endif
  243.  
  244. #ifdef TCL_USE_TIMEZONE_VAR
  245.     /*
  246.      * This is a horrible kludge for systems not having the timezone in
  247.      * struct tm.  No matter what was specified, they use the global time
  248.      * zone.  (Thanks Solaris).
  249.      */
  250.     if (useGMT) {
  251.         char *varValue;
  252.  
  253.         varValue = Tcl_GetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY);
  254.         if (varValue != NULL) {
  255.         savedTZEnv = strcpy(ckalloc(strlen(varValue) + 1), varValue);
  256.         } else {
  257.             savedTZEnv = NULL;
  258.     }
  259.         Tcl_SetVar2(interp, "env", "TZ", "GMT", TCL_GLOBAL_ONLY);
  260.         savedTimeZone = timezone;
  261.         timezone = 0;
  262.         tzset();
  263.     }
  264. #endif
  265.  
  266.     timeDataPtr = TclpGetDate((time_t *) &clockVal, useGMT);
  267.     
  268.     /*
  269.      * Make a guess at the upper limit on the substituted string size
  270.      * based on the number of percents in the string.
  271.      */
  272.  
  273.     for (bufSize = 1, p = format; *p != '\0'; p++) {
  274.     if (*p == '%') {
  275.         bufSize += 40;
  276.     } else {
  277.         bufSize++;
  278.     }
  279.     }
  280.     Tcl_DStringInit(&buffer);
  281.     Tcl_DStringSetLength(&buffer, bufSize);
  282.  
  283.     if ((TclStrftime(buffer.string, (unsigned int) bufSize, format,
  284.         timeDataPtr) == 0) && (*format != '\0')) {
  285.     Tcl_AppendStringsToObj(resultPtr, "bad format string \"",
  286.         format, "\"", (char *) NULL);
  287.     return TCL_ERROR;
  288.     }
  289.  
  290. #ifdef TCL_USE_TIMEZONE_VAR
  291.     if (useGMT) {
  292.         if (savedTZEnv != NULL) {
  293.             Tcl_SetVar2(interp, "env", "TZ", savedTZEnv, TCL_GLOBAL_ONLY);
  294.             ckfree(savedTZEnv);
  295.         } else {
  296.             Tcl_UnsetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY);
  297.         }
  298.         timezone = savedTimeZone;
  299.         tzset();
  300.     }
  301. #endif
  302.  
  303.     Tcl_SetStringObj(resultPtr, buffer.string, -1);
  304.     Tcl_DStringFree(&buffer);
  305.     return TCL_OK;
  306. }
  307.  
  308.